home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL2.LZH / FRACTAL.PAS < prev    next >
Pascal/Delphi Source File  |  1984-09-11  |  2KB  |  102 lines
  1. PROGRAM Fractal;
  2.  
  3. {  This program produces fractal images on the IBM PC hi-res graphics screen }
  4. {  according to your input specifications.  See the September 1984 issue of  }
  5. {  Byte magazine for details on fractals and this program.                   }
  6.  
  7. {  Writen for Turbo Pascal v2.0.  The 8087 version of Turbo Pascal should   }
  8. {  be used in order to achieve real time updating.                          }
  9.  
  10. {  The program uses the external procedure POINT.INV and CLS.INV.  Both of  }
  11. {  these must be resident on the default disk in order to compile the prgm. }
  12.  
  13. {  Adapted by Jeff Firestone; May 23, 1984.  HAL-PC Pascal SIG.             }
  14. {  Original Source: Greg Turk's program in Byte, Sept. 1984, p. 172.        }
  15.  
  16. CONST
  17.   cx = 300.0;
  18.   cy = 98.0;
  19.  
  20. VAR
  21.   i                      : INTEGER;
  22.   y,x,t,s,lx,ly,tx,ty,sc : REAL;
  23.   KeyBufPointer          : INTEGER;
  24.  
  25.  
  26. PROCEDURE cls; EXTERNAL 'Cls.inv';
  27. PROCEDURE Dot(a,b,c:INTEGER); EXTERNAL 'Point.inv';
  28.  
  29.  
  30. PROCEDURE InitVars;
  31. BEGIN
  32.   RANDOMIZE;
  33.   y:= 0;
  34.   x:= 0.50001;
  35. END;
  36.  
  37.  
  38. PROCEDURE GetValues;
  39. BEGIN
  40.   cls;
  41.   CLRSCR;
  42.   WRITELN('This program produces fractal images according to the following parameters.');
  43.   WRITELN;WRITELN;
  44.   WRITE('What is Lambda X (0 to 3) : ');
  45.   READLN(lx);
  46.   WRITE('What is Lambda Y (0 or 1) : ');
  47.   READLN(ly);
  48.   s:= SQR(lx) + SQR(ly);
  49.   lx:= 4 * lx / s;
  50.   ly:= -4 * ly / s;
  51.   WRITE('What is Scale (2 to 10) : ');
  52.   READLN(sc);
  53.   sc:= 2 * cx / sc;
  54.   KeyBufPointer:= MEMW[$0040:$001A];
  55. END;
  56.  
  57.  
  58. FUNCTION KeyWasPressed : BOOLEAN;
  59. BEGIN
  60.   IF KeyBufPointer <> MEMW[$0040:$001A]
  61.   THEN
  62.      KeyWasPressed:= TRUE
  63.   ELSE
  64.      KeyWasPressed:= FALSE;
  65. END;
  66.  
  67.  
  68. PROCEDURE XYfunction;
  69. BEGIN
  70.   tx:= x;
  71.   ty:= y;
  72.   x:= (tx * lx) - (ty * ly);
  73.   y:= (tx * ly) + (ty * lx);
  74.   x:= 1 - x;
  75.   t:= y;
  76.   s:= SQRT( SQR(x) + SQR(y) );
  77.   y:= SQRT( abs(-x + s) / 2 );
  78.   x:= SQRT( ( x + s) / 2 );
  79.   IF (t < 0) THEN x:= -x;
  80.   IF RANDOM < 0.5 THEN
  81.     BEGIN
  82.       x:= -x;
  83.       y:= -y;
  84.     END;
  85.   x:= (1 - x) / 2;
  86.   y:= y / 2;
  87. END;
  88.  
  89.  
  90.  
  91. BEGIN
  92.   InitVars;
  93.   GetValues;
  94.   HIRES;
  95.   hirescolor(7);
  96.   FOR i:= 1 TO 10 DO XYfunction;
  97.   REPEAT
  98.     dot(ROUND( (2 * sc * (x - 0.5)) + cx), ROUND(cy - (sc * y)), 1);
  99.     XYfunction;
  100.   UNTIL KeyWasPressed;
  101. END.
  102.